home *** CD-ROM | disk | FTP | other *** search
/ Developer CD Series 1992 June: ROMin Holiday / ADC Developer CD (1992-06) (''ROMin Holiday'')_iso / Developer Connection - 06-1992.iso / Development Platforms / HyperCard Related / XCMDs & XFCNs / Logic Manager / Tools / LMConv < prev    next >
Encoding:
Text File  |  1991-03-13  |  13.6 KB  |  616 lines  |  [TEXT/AAIS]
  1. /* LMCONV Program:                       */
  2. /*                                       */
  3. /* Use this program to convert Standard  */
  4. /* Prolog syntax programs into the       */
  5. /* Logic Manager syntax.                 */
  6. /*                                       */
  7. /* To run under AAIS Prolog, consult     */
  8. /* this file as well as file with        */
  9. /* desired code (which should not have   */
  10. /* clauses starting with "convert_").    */
  11. /* Then run "convert_work".              */
  12. /*                                       */
  13. /* Remember that this conversion program */
  14. /* has so far only been tested under     */
  15. /* AAIS Prolog.                          */
  16.  
  17. /*
  18. test :- convert_clauses(Defined,fred,0).
  19. fred :- write('Bratko test 7.3 begin'), nl, 
  20.     setof(F1,substitute(sin(x),2*sin(x)*f(sin(x)),t,F1),Z1),
  21.     setof(F2,substitute(a+b,f(a,A+B),v,F2),Z2),
  22.     write('Bratko test 7.3 finished'),nl.
  23. test :- convert_clauses(Defined,fred,1).
  24. fred(X) :- (nasty([1,2],[3,4]);fart(1),fart(2),fart(3)).
  25. test :- convert_clauses(Defined,fred,1).
  26. fred(X) :- nasty([1,2],[3,4]).
  27. fred(X) :- asserta(X :- (assertz(lm_trace_on),fail);fail).
  28. fred(X) :- Q = (assertz(lm_trace_on),fail),asserta(X :- Q).
  29. fred(X) :- asserta(X :- assertz(lm_trace_on),fail).
  30. concat([],X,X).
  31. concat([X|Y],Z,[X|W]) :- concat(Y,Z,W).
  32. test :- convert_clauses(Defined,lm_trace_backward,2).
  33. testq(X) :-
  34.     X = Y,
  35.     read(X),
  36.     write(X),
  37.     writel(X),
  38.     nl,
  39.     call(X),
  40.     asserta(X),
  41.     assertz(X),
  42.     !,
  43.     mangle(X,Y,Z),
  44.     compare(X,Y,Z),
  45.     arg(X,Y,Z),
  46.     arity(X,Y),
  47.     name(X,Y),
  48.     '$build'(X,Y),
  49.     var(X),
  50.     atom(X),
  51.     struct(X),
  52.     buff(X),
  53.     int(X),
  54.     const(X),
  55.     nonvar(X),
  56.     X < R,
  57.     X =< R,
  58.     X > R,
  59.     X >= R,
  60.     X == R,
  61.     X \= R,
  62.     functor(X,Y,Z),
  63.     Y is X + 1,
  64.     atomchars(X,Y),
  65.     (call(X);call(Y)),
  66.     length(X,Y),
  67.     not(X),
  68.     findall(X,Y,Z),
  69.     append(X,Y,Z),
  70.     X =.. Y,
  71.     setof(X,Y,Z),
  72.     bagof(X,Y,Z).
  73.  */
  74.  
  75. convert_work :- 
  76.     abolish(convert_last_char,1),
  77.     abolish(convert_names,1),
  78.     telling(T),
  79.     tell(dumpedclauses),
  80.     listing,
  81.     told,
  82.     assert(convert_names([])),
  83.     seeing(Old),
  84.     see(dumpedclauses),
  85.     get0(Y),
  86.     assert(convert_last_char(Y)),
  87.     !,
  88.     convert_scan_file,
  89.     seen,
  90.     seeing(Old),
  91.     retract(convert_names(L)),
  92.     convert_filter(L,LLL),
  93.     sort(LLL,LL),
  94.     assert(convert_count(0)),
  95.     tell(converted),
  96.     !,
  97.     convert_clause_list(LL,LL),
  98.     !,
  99.     nl,
  100.     told.
  101.  
  102. convert_work_purge :- 
  103.     abolish(convert_last_char,1),
  104.     abolish(convert_names,1),
  105.     telling(T),
  106.     tell(dumpedclauses),
  107.     listing,
  108.     told,
  109.     assert(convert_names([])),
  110.     seeing(Old),
  111.     see(dumpedclauses),
  112.     get0(Y),
  113.     assert(convert_last_char(Y)),
  114.     !,
  115.     convert_scan_file,
  116.     seen,
  117.     seeing(Old),
  118.     retract(convert_names(L)),
  119.     convert_filter(L,LL),
  120.     assert(convert_count(0)),
  121.     tell(converted),
  122.     convert_clause_list(LL,LL),
  123.     nl,
  124.     convert_purge(LL),
  125.     told.
  126.  
  127.  
  128. convert_purge([]).
  129.  
  130. convert_purge([N,A|R]) :-
  131.     abolish(N,A),
  132.     convert_purge(R).
  133.  
  134. convert_filter([Name,Arity|R],L) :-
  135.     name(Name,[99,111,110,118,101,114,116,95|_]),
  136.     !,
  137.     convert_filter(R,L).
  138. convert_filter([Name,Arity|R],[[Name,Arity]|L]) :-
  139.     !,
  140.     convert_filter(R,L).
  141. convert_filter([],[]).
  142.  
  143.  
  144. convert_clause_list(Defined,[[Name,Arity]|R]) :-
  145.     convert_clauses(Defined,Name,Arity),
  146.     !,
  147.     (R = [];
  148.      nl),
  149.     convert_clause_list(Defined,R).
  150.  
  151. convert_clause_list(Defined,[]).
  152.  
  153. convert_scan_file :-
  154.     repeat,
  155.     convert_some_file,
  156.     convert_last_char(-1),
  157.     !.
  158.  
  159. convert_some_file :- 
  160.     retract(convert_last_char(13)),  /* CR */ 
  161.     get0(X),
  162.     assertz(convert_last_char(X)),
  163.     !.
  164.  
  165. convert_some_file :-  /* name */
  166.     convert_last_char(47),
  167.     get0(42),
  168.     retract(convert_last_char(47)),
  169.     get0(_),
  170.     get0(Q),
  171.     convert_scan_clause_name(Q,T,T,N),
  172.     write(N),
  173.     nl,
  174.     convert_names(L),
  175.     convert_append(L,N,Z),
  176.     assert(convert_names(Z)),
  177.     retract(convert_names(L)),
  178.     get0(X),
  179.     assertz(convert_last_char(X)),
  180.     !.
  181.  
  182. convert_some_file :-  /* skip line */
  183.     convert_skip_line,
  184.     get0(X),
  185.     assertz(convert_last_char(X)),
  186.     !.
  187.  
  188. convert_some_file :- !.  /* EOF */ 
  189.  
  190. convert_skip_line :-
  191.     get0(X),
  192.     X >= 0,
  193.     (X = 13;convert_skip_line),
  194.     !.
  195.  
  196. convert_skip_line :-
  197.     abolish(convert_last_char,1),
  198.     assertz(convert_last_char(-1)),
  199.     !,
  200.     fail.
  201.  
  202.  
  203. convert_scan_clause_name(Q,Head,R,[Name,Arity]) :-
  204.     convert_name_table(Q),
  205.     Head = [Q|T],
  206.     !,
  207.     get0(C),
  208.     convert_scan_clause_name(C,T,R,[Name,Arity]).
  209.  
  210. convert_scan_clause_name(Q,Head,R,[Name,Arity]) :-
  211.     Q = 47, 
  212.     Head = [], 
  213.     name(Name,R), 
  214.     convert_scan_arity(Z,Z,Arity).
  215.  
  216.  
  217. convert_name_table(Q) :-
  218.     Q >= 97,
  219.     Q =< 122.
  220.  
  221. convert_name_table(Q) :-
  222.     Q >= 48,
  223.     Q =< 57.
  224.  
  225. convert_name_table(95).
  226.  
  227. convert_name_table(Q) :-
  228.     Q >= 65,
  229.     Q =< 90.
  230.  
  231.  
  232. convert_scan_arity(Head,R,Arity) :-
  233.     get0(Q),
  234.     (((Q >= 48,Q =< 57),
  235.       Head = [Q|T],
  236.       !,
  237.       convert_scan_arity(T,R,Arity));
  238.      (Q = 32, Head = [], name(Arity,R))).
  239.  
  240.  
  241. convert_append([],X,X).
  242. convert_append([X|Y],Z,[X|W]) :- convert_append(Y,Z,W).
  243.  
  244.  
  245. convert_clauses(Defined,Symbol,Arity) :-
  246.     functor(Clause,Symbol,Arity),
  247.     clause(Clause,L),
  248.     convert_and_write_clause(Defined,[0|_],0,(Clause:-L)),
  249.     put(46),                % 41 is '.'
  250.     nl,
  251.     nl,
  252.     fail.
  253.  
  254. convert_clauses(Defined,Symbol,Arity).
  255.  
  256.  
  257. convert_and_write_clause(Defined,Names,T,(Head:-Body)) :-
  258.     convert_do_tabs(T),
  259.     write('rule('),
  260.     TT is T + 1,
  261.     convert_and_write_term(Defined,Names,Head),
  262.     put(44),                % 44 is ','
  263.     nl,
  264.     !,
  265.     convert_and_write_body(Defined,Names,TT,Body),
  266.     put(41).                % 41 is ')'
  267.  
  268. convert_and_write_clause(Defined,Names,T,Head) :-
  269.     convert_do_tabs(T),
  270.     write('rule('),
  271.     TT is T + 1,
  272.     !,
  273.     convert_and_write_term(Defined,Names,Head),
  274.     put(44),                % 44 is ','
  275.     write(true),
  276.     put(41).                % 41 is ')'
  277.  
  278.  
  279. convert_and_write_body(Defined,Names,T,Goal) :- 
  280.     var(Goal), 
  281.     convert_do_tabs(T),
  282.     convert_variables(Goal,Names,Name),
  283.     write(Name),
  284.     !.
  285.  
  286. convert_and_write_body(Defined,Names,T,[Goal1]) :-
  287.     convert_and_write_body(Defined,Names,T,Goal1),
  288.     !.
  289.  
  290. convert_and_write_body(Defined,Names,T,[Goal1|Goal2]) :-
  291.     convert_do_tabs(T),
  292.     write('and('),
  293.     TT is T + 1,
  294.     nl,
  295.     !,
  296.     convert_and_write_body(Defined,Names,TT,Goal1),
  297.     put(44),                % 44 is ',' 
  298.     nl,
  299.     !,
  300.     convert_and_write_body(Defined,Names,TT,Goal2),
  301.     put(41).                % 41 is ')'
  302.  
  303. convert_and_write_body(Defined,Names,T,','(Goal1,Goal2)) :-
  304.     convert_do_tabs(T),
  305.     write('and('),
  306.     TT is T + 1,
  307.     nl,
  308.     !,
  309.     convert_and_write_body(Defined,Names,TT,Goal1),
  310.     put(44),                % 44 is ',' 
  311.     nl,
  312.     !,
  313.     convert_and_write_body(Defined,Names,TT,Goal2),
  314.     put(41).                % 41 is ')'
  315.  
  316. convert_and_write_body(Defined,Names,T,'->'(C,';'(Goal1,Goal2))) :-
  317.     convert_do_tabs(T),
  318.     write('if_then_else('),
  319.     TT is T + 1,
  320.     nl,
  321.     !,
  322.     convert_and_write_body(Defined,Names,TT,C),
  323.     put(44),                % 44 is ','
  324.     nl,
  325.     !,
  326.     convert_and_write_body(Defined,Names,TT,Goal1),
  327.     put(44),                % 44 is ',' 
  328.     nl,
  329.     !,
  330.     convert_and_write_body(Defined,Names,TT,Goal2),
  331.     put(41),                % 41 is ')'
  332.     convert_warn((C->Goal1;Goal2)).
  333.  
  334. convert_and_write_body(Defined,Names,T,'->'(C,Goal1)) :-
  335.     convert_do_tabs(T),
  336.     write('if_then('),
  337.     TT is T + 1,
  338.     nl,
  339.     !,
  340.     convert_and_write_body(Defined,Names,TT,C),
  341.     put(44),                % 44 is ','
  342.     nl,
  343.     !,
  344.     convert_and_write_body(Defined,Names,TT,Goal1),
  345.     put(41),                % 41 is ')'
  346.     convert_warn((C->Goal1)).
  347.  
  348. convert_and_write_body(Defined,Names,T,';'(Goal1,Goal2)) :-
  349.     convert_do_tabs(T),
  350.     write('or('),
  351.     TT is T + 1,
  352.     nl,
  353.     !,
  354.     convert_and_write_body(Defined,Names,TT,Goal1),
  355.     put(44),                % 44 is ',' 
  356.     nl,
  357.     !,
  358.     convert_and_write_body(Defined,Names,TT,Goal2),
  359.     put(41).                % 41 is ')'
  360.  
  361. convert_and_write_body(Defined,Names,T,!) :- 
  362.     convert_do_tabs(T),
  363.     write(cut),
  364.     !.
  365.  
  366. convert_and_write_body(Defined,Names,T,asserta(C)) :-
  367.     nonvar(C),
  368.     ( C=(_:-_), NC=C ; NC=(C:-true) ),
  369.     convert_do_tabs(T),
  370.     write('asserta('),
  371.     TT is T + 1,
  372.     nl,
  373.     !,
  374.     convert_and_write_clause(Defined,Names,TT,NC),
  375.     put(41).                % 41 is ')' 
  376.  
  377. convert_and_write_body(Defined,Names,T,assertz(C)) :-
  378.     nonvar(C),
  379.     ( C=(_:-_), NC=C ; NC=(C:-true) ),
  380.     convert_do_tabs(T),
  381.     write('assertz('),
  382.     TT is T + 1,
  383.     nl,
  384.     !,
  385.     convert_and_write_clause(Defined,Names,TT,NC),
  386.     put(41).                % 41 is ')' 
  387.  
  388. convert_and_write_body(Defined,Names,T,retract(C)) :-
  389.     nonvar(C),
  390.     ( C=(_:-_), NC=C ; NC=(C:-true) ),
  391.     convert_do_tabs(T),
  392.     write('retract('),
  393.     TT is T + 1,
  394.     nl,
  395.     !,
  396.     convert_and_write_clause(Defined,Names,TT,NC),
  397.     put(41).                % 41 is ')' 
  398.  
  399. convert_and_write_body(Defined,Names,T,Goal) :- 
  400.     convert_do_tabs(T),
  401.     ((atomic(Goal),
  402.       convert_funct_check(Defined,Goal,[],Size,Goal2));
  403.      (\+atomic(Goal),Goal = Goal2)),
  404.     convert_and_write_term(Defined,Names,Goal2),
  405.     !.
  406.  
  407.  
  408. convert_do_tabs(0).
  409.  
  410. convert_do_tabs(N) :-
  411.     write(' '),
  412.     NN is N - 1,
  413.     convert_do_tabs(NN).
  414.  
  415.  
  416. convert_variables(Goal,[I,N,T|R],Name) :-
  417.     II is I + 1,
  418.     R = [II|_],
  419.     (((Goal == N;(var(T),Goal = N)),
  420.       T = Name,
  421.       ((I =< 25,
  422.         X is I + 65,
  423.         name(Name,[X]));
  424.        (I > 25,
  425.         X is 64 + (I // 26),
  426.         Y is 65 + (I mod 26),
  427.         name(Name,[X,Y]))));
  428.      (Goal \== N,
  429.       convert_variables(Goal,R,Name))),
  430.     !.
  431.  
  432.  
  433. convert_and_write_term(Defined,Names,Goal) :- 
  434.     var(Goal), 
  435.     convert_variables(Goal,Names,Name), 
  436.     write(Name),
  437.     !.
  438.  
  439. convert_and_write_term(Defined,Names,[]) :- 
  440.     write(nil),
  441.     !.
  442.  
  443. convert_and_write_term(Defined,Names,Goal) :- 
  444.     atomic(Goal), 
  445.     writeq(Goal),
  446.     !.
  447.  
  448. convert_and_write_term(Defined,Names,[A|As]) :- 
  449.     convert_and_write_term(Defined,Names,cons(A,As)),
  450.     !.
  451.  
  452. convert_and_write_term(Defined,Names,Goal) :-
  453.     Goal=..[Funct|Args],
  454.     convert_list_length(Args,S),
  455.     ( convert_synonym(Funct,RFunct,S) ; RFunct=Funct ),        % check if functor needs renaming
  456.     convert_funct_check(Defined,RFunct,Args,Size,RRFunct),
  457.     ((convert_legal(RRFunct,Size), \+convert_and_quote(RRFunct,Size), write(RRFunct)); 
  458.      writeq(RRFunct)),
  459.     put(40),                % 40 is '('
  460.     !,
  461.     convert_process_args(Names,Args),
  462.     put(41).                % 41 is ')'
  463.  
  464.  
  465. convert_check_functor([F|R],[T|RR]) :- 
  466.     ((convert_name_table(F),F=T,convert_check_functor(R,RR));
  467.      (convert_check_functor(R,RRR),
  468.       name(F,N),convert_append(N,RRR,Z),
  469.       name('aSCII',X),convert_append(X,Z,[T|RR]))),
  470.     !.
  471.  
  472. convert_check_functor([],[]).
  473.  
  474.  
  475. convert_funct_check(Defined,Funct,Args,Size,Trans) :-
  476.     convert_list_length(Args,Size),
  477.     (convert_legal(Funct,Size),Funct=Trans;
  478.      convert_user_check(Funct,Size,Defined,Trans)),
  479.     !.
  480.  
  481.  
  482. convert_user_check(F,S,[[Funct,Size]|Defined],Trans) :-
  483.     ((nonvar(Size),F = Funct,S = Size,F = Trans);
  484.      (var(Size),
  485.       ((current_op(_,_,F),name(F,Chars),
  486.         convert_check_functor(Chars,NewChars),
  487.         name(Funct,NewChars),Funct = Trans);
  488.        (\+current_op(_,_,F),F = Funct,S = Size,F = Trans)))),
  489.     !.
  490.  
  491. convert_user_check(Funct,Size,[[_,S]|Defined],Trans) :-
  492.     nonvar(S),
  493.     convert_user_check(Funct,Size,Defined,Trans).
  494.  
  495. convert_user_check(Funct,Size,Defined,Funct) :-
  496.     telling(Stream),
  497.     tell(user),
  498.     write('illegal, undefined, or user database functor name: '),
  499.     write(Funct),
  500.     write('/'),
  501.     write(Size),
  502.     nl,
  503.     tell(Stream).
  504.  
  505.  
  506. convert_list_length([],0).
  507. convert_list_length([_|R],N) :-
  508.     !,
  509.     convert_list_length(R,NN),
  510.     N is NN + 1.
  511.  
  512.  
  513. convert_process_args(Names,[A]) :-
  514.     convert_and_write_term(Defined,Names,A),
  515.     !.
  516.     
  517. convert_process_args(Names,[A|Args]) :-
  518.     convert_and_write_term(Defined,Names,A),
  519.     put(44),                % 44 is ','
  520.     !,
  521.     convert_process_args(Names,Args).
  522.  
  523. convert_process_args(Names,[]) :- !.
  524.  
  525.  
  526. convert_warn(_).
  527. /*
  528. convert_warn(Goal) :-
  529.     telling(T),
  530.     tell(user),
  531.     write('convert_warning: built-in goal'), nl,
  532.     write(Goal), nl,
  533.     write('converted to equivalent LM built-in with different name'), nl,nl,
  534.     told,
  535.     tell(T).
  536. */  
  537.  
  538.  
  539. convert_legal('true',0).  /* not in documentation in LM? */
  540. convert_legal('fail',0).  /* not in documentation in LM? */
  541. convert_legal('abolish',2).  /* not in documentation in LM? */
  542. convert_legal('clause',2).  /* not in documentation in LM? */
  543. convert_legal('retract',1).  /* not documentation and not in LM */
  544. convert_legal('and',2).        convert_synonym(',','and',2).
  545. convert_legal('or',2).        convert_synonym(';','or',2).
  546.  
  547. convert_legal('=',2).
  548. convert_legal('eval',2).
  549. convert_legal('read',1).
  550. convert_legal('getterm',1).
  551. convert_legal('write',1).
  552. convert_legal('writel',1).
  553. convert_legal('nl',0).
  554. convert_legal('call',1).
  555. convert_legal('asserta',1).
  556. convert_legal('assertz',1).
  557. convert_legal('cut',0).
  558. convert_legal('mangle',3).
  559. convert_legal('compare',3).
  560. convert_legal('arg',3).
  561. convert_legal('arity',2).
  562. convert_legal('name',2).    convert_synonym('name','atomchars',2).
  563. convert_legal('$build',2).    convert_and_quote('$build',2).
  564. convert_legal('var',1).
  565. convert_legal('atom',1).
  566. convert_legal('struct',1).
  567. convert_legal('buff',1).
  568. convert_legal('integer',1).
  569. convert_legal('const',1).
  570. convert_legal('nonvar',1).
  571. convert_legal('@<',2).        convert_synonym('<','@<',2).
  572. convert_legal('@=<',2).        convert_synonym('=<','@=<',2).
  573. convert_legal('@>',2).        convert_synonym('>','@>',2).    
  574. convert_legal('@>=',2).        convert_synonym('>=','@>=',2).
  575. convert_legal('==',2).
  576. convert_legal('different',2).    convert_synonym(X,different,2) :- name(X,[92,61]).
  577.                 convert_synonym('!=',different,2).  /* is this right? */
  578. convert_legal('functor',3).
  579. convert_legal('is',2).
  580. convert_legal('atomchars',2).
  581. convert_legal('or',2).
  582. convert_legal('length',2).
  583. convert_legal('not',1).
  584. convert_legal('sort',2).
  585. convert_legal('copy',2).
  586. convert_legal('findall',3).
  587. convert_legal('append',3).
  588. convert_legal('univ',2).    convert_synonym('=..',univ,2).
  589. convert_legal('setof',3).
  590. convert_legal('bagof',3).
  591. convert_legal('add',2).        convert_synonym(+,add,2).
  592. convert_legal('sub',2).        convert_synonym(-,sub,2).
  593. convert_legal('band',2).    convert_synonym(/\,band,2).
  594. convert_legal('lshift',2).    convert_synonym(<<,lshift,2).
  595. convert_legal('rshift',2).    convert_synonym(>>,rshift,2).
  596. convert_legal('bor',2).        convert_synonym(\/,bor,2).
  597. convert_legal('xor',2).
  598. convert_legal('mul',2).        convert_synonym(*,mul,2).
  599. convert_legal('div',2).        convert_synonym(/,div,2).
  600. convert_legal('idiv',2).    convert_synonym(//,idiv,2).
  601. convert_legal('mod',2).
  602. convert_legal('xpy',2).
  603. convert_legal('not',1).
  604. convert_legal('sqrt',1).
  605. convert_legal('round',1).
  606. convert_legal('trunc',1).
  607. convert_legal('exp',1).
  608. convert_legal('sin',1).
  609. convert_legal('cos',1).
  610. convert_legal('tan',1).
  611. convert_legal('atan',1).
  612. convert_legal('log2',1).
  613. convert_legal('ln',1).
  614. convert_legal('neg',1).
  615.  
  616.